;;; Lepton EDA Schematic to PCB conversion
;;; Scheme API
;;; Copyright (C) 2023-2025 Lepton EDA Contributors
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2 of the License, or
;;; (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.

(define-module (sch2pcb insert)
  #:use-module (ice-9 format)
  #:use-module (ice-9 rdelim)
  #:use-module (system foreign)

  #:use-module (lepton ffi boolean)
  #:use-module (lepton ffi sch2pcb)
  #:use-module (lepton file-system)

  #:use-module (sch2pcb element)
  #:use-module (sch2pcb format)

  #:export (insert-file-element))

(define (call-protected thunk msgfmt . msgargs)
  (catch 'system-error
    thunk
    (lambda (key func fmt fmtargs data)
      (apply format (current-error-port) msgfmt msgargs)
      (apply format (current-error-port) fmt fmtargs)
      (display "\n" (current-error-port)))))

;;; Scan file contents to detect whether it's actually a PCB
;;; layout. Assumes that a PCB layout will have a "PCB" line.
(define (layout-file? file)
  (with-input-from-file file
    (lambda ()
      (let loop ((s (read-line)))
        (and (not (eof-object? s))
             (or (string-prefix? "PCB"
                                 (string-trim s char-set:whitespace))
                 (loop (read-line))))))))


;;; A problem is that new PCB 1.7 file elements have the
;;; (mark_x,mark_y) value set to wherever the element was created
;;; and no equivalent of a gschem translate symbol was done.
;;;
;;; So, file elements inserted can be scattered over a big area
;;; and this is bad when loading a file.new.pcb into an existing
;;; PC board.  So, do a simple translate if (mark_x,mark_y) is
;;; (arbitrarily) over 1000.  I'll assume that for values < 1000
;;; the element creator was concerned with a sane initial element
;;; placement.  Unless someone has a better idea?  Don't bother
;;; with pre PCB 1.7 formats as that would require parsing the
;;; mark().  Current m4 elements use the old format but they seem
;;; to have a reasonable initial mark().
(define (simple-translate *element)
  (pcb_element_set_x *element (string->pointer "0"))
  (pcb_element_set_y *element (string->pointer "0")))


(define (insert-file-element element-filename *element)
  "Output the contents of the file ELEMENT-FILENAME to the current
output port replacing its fields 'footprint', 'refdes', and
'value' with the corresponding fields of *ELEMENT."
  (if (call-protected (lambda () (layout-file? element-filename))
                      "insert-file-element(): can't open ~A: "
                      element-filename)
      (begin
        (format (current-error-port)
                "Warning: ~A appears to be a PCB layout file. Skipping.\n"
                element-filename)
        #f)
      ;; File is readable, we've checked this in
      ;; call-protected() above.  Therefore no additional
      ;; check is needed here.
      (with-input-from-file element-filename
        (lambda ()
          (let loop ((s (read-line))
                     (return #f))
            (if (eof-object? s)
                return
                (loop (read-line)
                      (or (let* ((trimmed-line
                                  (string-trim
                                   (string-append s "\n") char-set:whitespace))
                                 (*new-element
                                  (pcb_element_line_parse
                                   (string->pointer trimmed-line)))
                                 (valid-element? (not (null-pointer? *new-element))))
                            ;; Copy the file element lines.
                            ;; Substitute new parameters into the
                            ;; Element() or Element[] line and
                            ;; strip comments.
                            (if valid-element?
                                (begin
                                  (simple-translate *new-element)
                                  (let ((fmt (format #f
                                                     "~?"
                                                     (if (true? (pcb_element_get_quoted_flags *new-element))
                                                         "Element~A~S ~S ~S ~S ~A ~A~A\n"
                                                         "Element~A~A ~S ~S ~S ~A ~A~A\n")
                                                     (list
                                                      (list->string (list (integer->char (pcb_element_get_res_char *new-element))))
                                                      (pointer->string (pcb_element_get_flags *new-element))
                                                      (pointer->string (pcb_element_get_description *element))
                                                      (pointer->string (pcb_element_get_refdes *element))
                                                      (pointer->string (pcb_element_get_value *element))
                                                      (pointer->string (pcb_element_get_x *new-element))
                                                      (pointer->string (pcb_element_get_y *new-element))
                                                      (pointer->string (pcb_element_get_tail *new-element))))))
                                    (display fmt)))
                                (when (not (string-prefix? "#" trimmed-line))
                                  (display (string-append s "\n"))))
                            (free-element *new-element)
                            valid-element?)
                          return))))))))
